home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Taifun / Taifun 102 (1989-08-15)(Ossowski, Stefan)(DE)(PD).zip / Taifun 102 (1989-08-15)(Ossowski, Stefan)(DE)(PD).adf / Video_V2.11 / Video_V 2.11 < prev    next >
Text File  |  1989-04-26  |  24KB  |  1,193 lines
  1. first:
  2.   MENU 1,0,1,""
  3.   MENU 2,0,1,""
  4.   MENU 3,0,1,""
  5.   MENU 4,0,1,""
  6.   DEFINT a-z
  7.   DIM gr%(7340),ftitel$(400),mwnamen1$(400),mwnamen2$(400),musik$(400),regie$(400)
  8.   DIM kasnr%(400)
  9.   GOTO start           
  10. second:
  11.   CLEAR
  12. start:
  13.   SCREEN 1,320,200,2,1
  14.   WINDOW 2,"               VIDEO",(0,0)-(310,180),16,1
  15. dateifrage:
  16.   CLS
  17.   LOCATE 5,1
  18.     PRINT "Bitte Dateiname eingeben.        "
  19.   LOCATE 6,1
  20.     PRINT "Wenn kein Name eingegeben wird   "
  21.   LOCATE 7,1
  22.     PRINT "ist der aktuelle Name:           "
  23.   LOCATE 8,1
  24.     PRINT "        [VID.FILME_DAT]          "
  25.   LOCATE 9,1
  26.     PRINT "Unter dem eingegeben Namen wird  "
  27.   LOCATE 10,1
  28.     PRINT "die Datei auch abgespeichert.    "  
  29.   LOCATE 13,1
  30.   INPUT"",datei$
  31.   IF datei$="" THEN
  32.     datei$="VID.FILME-DAT"
  33.   END IF
  34.   CLS  
  35. Anfang:  
  36.   GOSUB grafik 
  37.   GOSUB farbe             
  38.   GOSUB abfrage
  39.   schluss=1
  40. ablauf:
  41.   ON MENU GOSUB mkontrolle:MENU ON
  42.   WHILE schluss
  43.     SLEEP
  44.   WEND                     
  45.   MENU RESET:END
  46. abfrage:
  47.   MENU 1,0,1,"Disk"
  48.   MENU 1,1,1,"Einlesen"
  49.   MENU 1,2,1,"Abspeichern"
  50.   MENU 1,3,1,"Drucken"
  51.   MENU 1,4,1,"Ende"
  52.   MENU 2,0,1,"Verwaltung"
  53.   MENU 2,1,1,"Eintragen" 
  54.   MENU 2,2,1,"Auflisten-Filme"
  55.   MENU 2,3,1,"Auflisten-Kassetten"
  56.   MENU 2,4,1,"Gesamtlisten"
  57.   MENU 2,5,1,"Suchen"
  58.   MENU 2,6,1,"Veraendern"
  59.   MENU 3,0,1,"Info"
  60.   MENU 3,1,1,"Autor"
  61.   MENU 3,2,1,"Handhabung"
  62.   MENU 4,0,1,""
  63.   RETURN
  64. mkontrolle: 
  65.   IF ausu THEN RETURN
  66.   mtitel=MENU (0)
  67.   mpunkt=MENU (1)
  68.   ON mtitel GOSUB disk,verwaltung,info
  69.   RETURN
  70. disk:
  71.   ausu=-1
  72.   ON mpunkt GOSUB einlesen,abspeichern,drucken,Ende
  73.   ausu=0
  74.   RETURN
  75. info:
  76.   ausu=1
  77.   ON mpunkt GOSUB autor,handhabung
  78.   ausu=0 
  79.   RETURN 
  80. verwaltung:
  81.   ausu=-1
  82.   ON mpunkt GOSUB eintragen,auflisten,aufkassette,gesamtliste,suchen,veraendern
  83.   ausu=0
  84.   RETURN
  85. einlesen:
  86.   MENU OFF
  87.   CLS
  88.   y=0
  89.   ' ON ERROR GOTO fehler
  90.   OPEN datei$ FOR INPUT AS #1
  91.   WHILE NOT EOF(1)
  92.     y=y+1
  93.     LINE INPUT#1,ftitel$(y)
  94.     LINE INPUT#1,mwnamen1$(y)
  95.     LINE INPUT#1,mwnamen2$(y)
  96.     LINE INPUT#1,musik$(y)
  97.     LINE INPUT#1,regie$(y)
  98.     INPUT#1,kasnr%(y)
  99.   WEND
  100.   CLOSE#1
  101.   vdfilme=y
  102.   einlesefilme=y      
  103.   anlegen=1
  104.   MENU ON
  105.   GOSUB farbe
  106.   RETURN
  107. fehler:
  108.   IF ERR=53 THEN
  109.     CLOSE#1
  110.     LOCATE 7,11
  111.       PRINT "Datei ist nicht vorhanden !!!"
  112.     LOCATE 9,11
  113.       PRINT "Programm wird neu gestartet"
  114.     GOSUB taste   
  115.     RESUME second
  116.   END IF
  117.   GOTO start
  118. abspeichern:
  119.   CLS
  120.   MENU OFF
  121.   IF speichern=1 THEN 
  122.     GOTO neudatei
  123.   END IF   
  124.   IF vdfilme=0 OR einlesefilme=vdfilme THEN
  125.     COLOR 2,3
  126.     LOCATE 8,6
  127.       PRINT "Es wurde nichts zum"
  128.     LOCATE 10,4
  129.       PRINT "abspeichern eingegeben !!"
  130.     COLOR 0,1
  131.     GOSUB taste
  132.     GOTO schlusseintrag
  133.   END IF        
  134.   IF anlegen=1 THEN
  135.     GOTO schreibdatei
  136.   END IF
  137.   GOTO neudatei
  138. schreibdatei:
  139.   OPEN datei$ FOR APPEND AS #1
  140.   FOR y=einlesefilme+1 TO vdfilme
  141.     PRINT #1,ftitel$(y)
  142.     PRINT #1,mwnamen1$(y)
  143.     PRINT #1,mwnamen2$(y)
  144.     PRINT #1,musik$(y)
  145.     PRINT #1,regie$(y)
  146.     PRINT #1,kasnr%(y)
  147.   NEXT
  148.   CLOSE #1
  149.   anlegen=0
  150.   GOTO schlusseintrag 
  151. neudatei:
  152.   OPEN datei$ FOR OUTPUT AS #1
  153.   FOR y=1 TO vdfilme
  154.     PRINT #1,ftitel$(y)
  155.     PRINT #1,mwnamen1$(y)
  156.     PRINT #1,mwnamen2$(y)
  157.     PRINT #1,musik$(y)
  158.     PRINT #1,regie$(y)
  159.     PRINT #1,kasnr%(y)
  160.   NEXT
  161.   CLOSE #1 
  162.   speichern=0     
  163. schlusseintrag:
  164.   IF Ende=1 THEN RETURN               
  165.   MENU ON
  166.   GOSUB farbe
  167.   RETURN
  168. Ende:
  169.   CLS
  170.   MENU OFF
  171.   LOCATE 2,13
  172.     PRINT "Ende"
  173.   Ende=1
  174.   IF speichern=1 THEN
  175.     LOCATE 4,1
  176.       PRINT "Es wurden noch nicht alle"
  177.     LOCATE 6,1  
  178.       PRINT "Eintragungen oder Veränderungen"
  179.     LOCATE 8,1
  180.       PRINT "neu abgespeichert."
  181.     FOR b=0 TO 10000:NEXT  
  182.     GOSUB abspeichern    
  183.     LOCATE 10,1
  184.       PRINT "Habe soeben alles gespeichert."
  185.     LOCATE 12,10
  186.       PRINT "Tschüss !!!"
  187.   END IF       
  188.   GOSUB taste:MENU RESET:CLS
  189.   WINDOW CLOSE 1
  190.   SCREEN CLOSE 1
  191.   END
  192.   RETURN
  193. eintragen:
  194.   COLOR 1,0
  195.   CLS
  196.   MENU OFF
  197.   COLOR 3,2
  198.   LOCATE 1,10
  199.     PRINT "Eintragen"
  200.   x=vdfilme
  201.   x=x+1
  202. anfangeintr: 
  203.   COLOR 1,0
  204.   LOCATE 2,1
  205.     PRINT "Filme auf schon vorhandenen    "
  206.     PRINT "Kassetten müssen bei Verändern "
  207.     PRINT "eingetragen werden.            "
  208.   LOCATE 6,11
  209.     PRINT  "Titel"
  210.   LOCATE 7,1
  211.     LINE INPUT "",titel$
  212.   IF va=1 THEN
  213.     IF titel$="0" THEN
  214.       va=0
  215.       RETURN
  216.     END IF   
  217.     IF titel$="" THEN
  218.       LOCATE 9,2
  219.         PRINT "Bitte Titel eingeben"
  220.       LOCATE 11,2
  221.         PRINT "oder [0] für Ende."
  222.       GOSUB taste
  223.       CLS  
  224.       GOTO anfangeintr  
  225.     END IF       
  226.     vdfilme=vdfilme+1
  227.     FOR m=vdfilme TO y+1 STEP -1
  228.       ftitel$(m)=ftitel$(m-1)
  229.       mwnamen1$(m)=mwnamen1$(m-1)
  230.       mwnamen2$(m)=mwnamen2$(m-1)
  231.       musik$(m)=musik$(m-1)
  232.       regie$(m)=regie$(m-1)
  233.       kasnr%(m)=kasnr%(m-1)
  234.     NEXT
  235.     x=x+1
  236.     ftitel$(x)=titel$
  237.     speicher=1
  238.   END IF
  239.   IF titel$="" THEN  
  240.     x=x-1 
  241.     GOTO ew
  242.   END IF 
  243.   ftitel$(x)=titel$   
  244.   LINE INPUT "Mitwirkende: ",mwnamen1$(x)
  245.   IF mwnamen1$(x)="" THEN mwnamen1$(x)="Name unbekannt"
  246.   LINE INPUT "Mitwirkende: ",mwnamen2$(x)
  247.   IF mwnamen2$(x)="" THEN mwnamen2$(x)="Name unbekannt"
  248.   LINE INPUT "Musik : ",musik$(x)
  249.   IF musik$(x)="" THEN musik$(x)="Name unbekannt"
  250.   LINE INPUT "Regie : ",regie$(x)
  251.   IF regie$(x)="" THEN regie$(x)="Name unbekannt" 
  252.   IF va=1 THEN 
  253.     va=0
  254.     RETURN
  255.   END IF   
  256. kassnr:
  257.   LOCATE 12,1
  258.     INPUT "Nummer VD-Kassette :",kasnr%(x)
  259.   IF kasnr%(x)=0 THEN kassnr
  260.   PRINT
  261. ew: 
  262.   LOCATE 15,10
  263.     PRINT "Ende =" 
  264.   COLOR 3,2
  265.   LOCATE 15,18
  266.     PRINT ">E<"
  267.   COLOR 1,0
  268.   LOCATE 16,6
  269.     PRINT "Weitermachen ="
  270.   COLOR 3,2
  271.   LOCATE 16,22
  272.     PRINT ">W<"
  273.   vdfilme=x
  274. vdwarten:  
  275.   a$=INKEY$
  276.   IF a$="e" THEN 
  277.     IF einlesefilme=0 THEN
  278.       anlegen=1
  279.       MENU ON
  280.       GOSUB farbe
  281.       RETURN
  282.     END IF   
  283.     IF  einlesefilme<>vdfilme THEN
  284.       speichern=1
  285.     END IF
  286.     MENU ON
  287.     GOSUB farbe
  288.     RETURN
  289.   END IF  
  290.   IF a$="w" THEN eintragen
  291.   GOTO vdwarten
  292. auflisten:           
  293.   MENU OFF
  294.   CLS 
  295.   IF vdfilme=0 THEN 
  296.     fehl$="AUFGELISTET"
  297.     GOSUB fehlanzeige
  298.     MENU ON
  299.     GOSUB farbe
  300.     RETURN 
  301.   END IF
  302.   COLOR 3,2
  303.   LOCATE 2,10
  304.     PRINT "AUFLISTEN"
  305.   numfika$="gelistet"
  306.   numfika1$="Film-Nr."
  307.   GOSUB nummerfika
  308.   x=f
  309.   CLS  
  310. mehrlisten:
  311.   COLOR 2,0
  312.   IF x>vdfilme THEN weiter
  313.     LOCATE z,2
  314.       PRINT "Film-Nr."
  315.     COLOR 3,2  
  316.     LOCATE z+1,5
  317.       PRINT "   "
  318.     LOCATE z+1,5
  319.       PRINT  x
  320.     COLOR 2,0  
  321.     LOCATE z,22
  322.       PRINT "Kas.-Nr."
  323.     COLOR 3,2  
  324.     LOCATE z+1,25
  325.       PRINT "   "
  326.     LOCATE z+1,25
  327.       PRINT kasnr%(x) 
  328.     COLOR 2,0
  329.     test$=ftitel$(x)
  330.     GOSUB stringtest
  331.     ftitel$(x)=test$
  332.     LOCATE y,1
  333.       PRINT "                                "  
  334.     LOCATE y,stelle    
  335.       PRINT ftitel$(x)
  336.     IF su= 1 THEN 
  337.       GOSUB taste
  338.       su=0
  339.       RETURN
  340.     END IF
  341.     IF su=2 THEN
  342.       IF nrkass=kasnr%(x+1) THEN
  343.         x=x+1 :z=z+4 :y=y+4
  344.         GOTO mehrlisten
  345.       END IF 
  346.       GOSUB taste
  347.       su=0
  348.       RETURN
  349.     END IF     
  350.     IF su= 3 THEN
  351.       GOSUB taste
  352.       su=0
  353.       RETURN
  354.     END IF   
  355.     LOCATE 5,10
  356.     COLOR 3,2
  357.       PRINT "Mitwirkende"
  358.     COLOR 1,0
  359.       PRINT
  360.     test$=mwnamen1$(x)
  361.     GOSUB stringtest
  362.     mwnamen1$(x)=test$
  363.     LOCATE 7,1
  364.       PRINT "                                "
  365.     LOCATE 7,stelle 
  366.       PRINT USING"&";mwnamen1$(x)
  367.     test$=mwnamen2$(x)
  368.     GOSUB stringtest
  369.     mwnamen2$(x)=test$
  370.     LOCATE 8,1
  371.       PRINT "                                "
  372.     LOCATE 8,stelle
  373.       PRINT USING"&";mwnamen2$(x)
  374.     COLOR 3,2
  375.     LOCATE 10,13 
  376.       PRINT "Musik";
  377.     COLOR 1,0
  378.     test$=musik$(x)
  379.     GOSUB stringtest
  380.     musik$(x)=test$
  381.     LOCATE 12,1
  382.       PRINT "                                "
  383.     LOCATE 12,stelle
  384.       PRINT USING"&";musik$(x)
  385.     COLOR 3,2
  386.     LOCATE 14,13 
  387.       PRINT "Regie"
  388.     COLOR 1,0
  389.     test$=regie$(x)
  390.     GOSUB stringtest
  391.     regie$(x)=test$
  392.     LOCATE 16,1
  393.       PRINT "                                "
  394.     LOCATE 16,stelle
  395.       PRINT USING"&";regie$(x)
  396.       PRINT
  397.     COLOR 2,3
  398.     LOCATE 18,3
  399.       PRINT "WEITER?"
  400.     LOCATE 18,22
  401.       PRINT "ENDE?"
  402. listfrage:
  403.     LINE (40,165)-(65,190),2,bf
  404.     LINE (220,165)-(245,190),2,bf
  405. mausfrage:      
  406.     listen=0
  407.     WHILE MOUSE(0)=0
  408.     WEND
  409.     mx=MOUSE(1):my=MOUSE(2)
  410.     IF (mx>40 AND mx<65) AND (my>165 AND my<190) THEN
  411.       listen=-1
  412.       LINE (40,165)-(65,190),3,bf
  413.       SOUND 246,2
  414.       x=x+1
  415.     END IF
  416.     IF (mx>220 AND mx<245) AND (my>165 AND my<190) THEN
  417.       listen=1
  418.       LINE (220,165)-(245,190),3,bf
  419.       SOUND 1318,2
  420.     END IF
  421.     WHILE MOUSE(0)<>0
  422.     WEND
  423.     LINE (40,165)-(65,190),2,bf
  424.     LINE (220,165)-(245,190),2,bf
  425.     IF listen=-1 THEN mehrlisten
  426.     IF listen=1 THEN weiter   
  427.     GOTO mausfrage
  428. weiter:
  429.     MENU ON
  430.     GOSUB farbe
  431.     RETURN
  432. stringtest:
  433.     te=LEN(test$)
  434.     IF te>31 THEN test$=LEFT$(test$,31)
  435.       stelle=INT(16-(LEN(test$)/2))
  436.     IF stelle=0 THEN stelle=1  
  437.     RETURN
  438. suchen:
  439.   PALETTE 0,1,1,0 'schwarz
  440.   CLS
  441.   MENU OFF
  442.   COLOR 2
  443.   LOCATE 1,12
  444.     PRINT "SUCHEN"
  445.    IF vdfilme=0 THEN
  446.       fehl$="GESUCHT"
  447.       GOSUB fehlanzeige
  448.       MENU ON
  449.       GOSUB farbe
  450.       RETURN 
  451.    END IF       
  452.    LOCATE 3,3
  453.     PRINT "Nach welchem Kriterium soll "
  454.   LOCATE 5,3
  455.     PRINT "gesucht werden."
  456.   LOCATE 9,3
  457.     PRINT "(1) Film-Nummer"
  458.   LOCATE 11,3  
  459.     PRINT "(2) Kassetten-Nummer"
  460.   LOCATE 13,3
  461.     PRINT "(3) Film-Titel"
  462.   LOCATE 17,3
  463.     PRINT "Bitte auswählen"    
  464. austaste:
  465.   su$=INKEY$
  466.   IF su$="" THEN austaste
  467.   IF su$="1" THEN finummer
  468.   IF su$="2" THEN kanummer
  469.   IF su$="3" THEN fititel
  470.   GOTO austaste
  471. finummer:
  472.   CLS
  473.    LOCATE 1,12
  474.     PRINT "SUCHEN"
  475.    LOCATE 4,5              
  476.     PRINT "Bitte jetzt die Nummer "
  477.    LOCATE 6,5 
  478.     PRINT "des Filmes eingeben."
  479. nreingabe:   
  480.    LOCATE 8,5
  481.     PRINT "           "
  482.    LOCATE 8,5 
  483.     INPUT "Nr.:",nrfilm
  484.     IF nrfilm > vdfilme THEN nreingabe
  485.      x=nrfilm :su=1 :z=1 :y=3 :CLS
  486.     GOSUB mehrlisten
  487.     GOTO schlusuchen
  488. kanummer:
  489.   CLS
  490.   LOCATE 4,5
  491.    PRINT "Bitte jetzt die Nummer"
  492.   LOCATE 6,5
  493.    PRINT "der Kassette eingeben."
  494. nreingabe1:
  495.   LOCATE 8,5
  496.    INPUT"Nr.:",nrkass 
  497.   IF nrkass> kasnr%(vdfilme) THEN nreingabe1
  498. zaehlen:
  499.    k=k+1
  500.    IF nrkass = kasnr%(k) THEN 
  501.       x=k :su=2 :z=1 :y=3 :CLS
  502.       GOSUB mehrlisten
  503.       k=vdfilme
  504.    END IF
  505.   IF k<= vdfilme THEN zaehlen
  506.   k=0
  507.   GOTO schlusuchen
  508. fititel:
  509.   CLS
  510.   LOCATE 3,2
  511.   PRINT "Bitte jetzt den gesuchten "
  512.   LOCATE 5,2
  513.   PRINT "Filmtitel eingeben."
  514.   LOCATE 7,2
  515.   PRINT "Min. 4 Buchstaben."
  516. suchfilm:  
  517.   LOCATE 9,2
  518.   INPUT suchfilm$
  519.   IF LEN(suchfilm$) <4 THEN
  520.     PRINT " Min. 4 Buchstaben."
  521.     warten=5
  522.     GOSUB warte
  523.     GOTO fititel
  524.   END IF  
  525.   k=0
  526. wsfilm:
  527.   k=k+1
  528.   s=LEN(suchfilm$)
  529.   sf$=LEFT$(ftitel$(k),s)
  530.   s$=UCASE$(sf$):such$=UCASE$(suchfilm$)
  531.   IF such$=s$ THEN
  532.     x=k :su=3 :z=1 :y=3 :CLS
  533.     GOSUB mehrlisten
  534.     k=vdfilme
  535.   END IF 
  536.   IF k< vdfilme THEN wsfilm
  537. schlusuchen:  
  538.   MENU ON
  539.   GOSUB farbe
  540.   RETURN
  541. veraendern:
  542.   CLS
  543.   MENU OFF
  544.    PALETTE 0,0,0,.6'schwarzblau
  545.    PALETTE 1,1,.8,0'sand
  546.    PALETTE 2,.6,1,.1'giftgruen
  547.    PALETTE 3,.4,.4,.4'dunkelbraun
  548.    IF vdfilme=0 THEN
  549.       fehl$="VERÄNDERT"
  550.       GOSUB fehlanzeige
  551.       MENU ON
  552.       GOSUB farbe
  553.       RETURN 
  554.    END IF       
  555.    COLOR 2
  556.    LOCATE 2,4
  557.      PRINT "Bitte auswählen was ver="
  558.    LOCATE 4,4
  559.      PRINT "ändert werden soll!!!"
  560.    LOCATE 9,5
  561.      PRINT "[1] Film löschen"
  562.    LOCATE 11,5
  563.      PRINT "[2] Film eintragen"
  564.    LOCATE 13,5
  565.      PRINT "[3] Einträge ändern"
  566. eintaste:
  567.   su$=INKEY$
  568.   IF su$="" THEN eintaste
  569.   IF su$="1" THEN loeschen
  570.   IF su$="2" THEN neufilm
  571.   IF su$="3" THEN einaendern
  572.   GOTO eintaste
  573. loeschen:
  574.    CLS
  575.    COLOR 2
  576.      LOCATE 3,3
  577.        PRINT "Welche Film-Nummer soll"
  578.      LOCATE 5,3
  579.        PRINT "gelöscht werden"
  580.      LOCATE 7,3
  581.        PRINT "Falls Nummer nicht bekannt,"
  582.      LOCATE 9,3 
  583.        PRINT "0 Eingeben und Auflisten"
  584.      LOCATE 11,3
  585.        PRINT "auswählen."
  586. eingabeloeschen: 
  587.      LOCATE 5,19
  588.        PRINT "    "          
  589.      LOCATE 5,19
  590.        INPUT ;loeschfilm
  591.      IF loeschfilm=0 THEN endveraendern
  592.      IF loeschfilm>vdfilme THEN eingabeloeschen
  593.      CLS
  594.      COLOR 1
  595.      LOCATE 2,3
  596.        PRINT "Soll Film-Nr.";loeschfilm;"wirklich"
  597.      LOCATE 4,3 
  598.        PRINT "gelöscht werden?"
  599.      COLOR 3,0  
  600.      test$=ftitel$(loeschfilm)
  601.      GOSUB stringtest 
  602.      LOCATE 7,stelle
  603.        PRINT test$  
  604. sicherfrage:  
  605.     COLOR 1  
  606.     LOCATE 10,7
  607.        PRINT "[J]a oder [N]ein?"
  608.          sicher$=INKEY$
  609.        IF sicher$="j" THEN wegdamit
  610.        IF sicher$="n" THEN endveraendern
  611.        GOTO sicherfrage
  612. wegdamit:
  613.     speichern=1
  614.     IF kasnr%(loeschfilm)>kasnr%(loeschfilm-1) AND kasnr%(loeschfilm)>kasnr%(loeschfilm+1) THEN
  615.       GOSUB filmloeschen
  616.       GOTO wloeschen
  617.     END IF   
  618.     IF kasnr%(loeschfilm)=kasnr%(loeschfilm-1) THEN
  619.        GOSUB filmloeschen
  620.        GOTO wloeschen
  621.     ELSEIF kasnr%(loeschfilm)=kasnr%(loeschfilm+1) THEN
  622.        GOSUB filmloeschen
  623.        GOTO wloeschen
  624.     END IF
  625.        ftitel$(loeschfilm)="noch nichts"      
  626.        mwnamen1$(loeschfilm)=""
  627.        mwnamen2$(loeschfilm)=""
  628.        musik$(loeschfilm)=""
  629.        regie$(loeschfilm)=""
  630.        GOTO endveraendern
  631. wloeschen:       
  632.    l=loeschfilm    
  633.    FOR x=l TO vdfilme-1
  634.        ftitel$(x)=ftitel$(x+1)
  635.        mwnamen1$(x)=mwnamen1$(x+1)
  636.        mwnamen2$(x)=mwnamen2$(x+1)
  637.        musik$(x)=musik$(x+1)
  638.        regie$(x)=regie$(x+1)
  639.        kasnr%(x)=kasnr%(x+1)
  640.     NEXT
  641.     vdfilme=vdfilme-1 
  642.     GOTO endveraendern
  643. neufilm:
  644.    CLS
  645.    PALETTE 1,0,0,.6'schwarzblau
  646.    PALETTE 0,1,.8,0'sand
  647.    COLOR 1
  648.    LOCATE 3,2
  649.      PRINT "Bitte die Nummer der Kassette"
  650.    LOCATE 5,2
  651.      PRINT "eingeben,auf der der Film ist."
  652.    LOCATE 7,2
  653.      PRINT "Die Eingabe von [0] beendet"
  654.    LOCATE 9,2
  655.      PRINT "den Programmteil."
  656. nummereintragen:
  657.    LOCATE 12,2
  658.      INPUT "Kassetten-Nr.";einnummer
  659.      IF einnummer>kasnr%(vdfilme) THEN
  660.         CLS
  661.         LOCATE 3,2
  662.           PRINT "Diese Kassetten-Nr. existiert"
  663.         LOCATE 5,2
  664.           PRINT "noch nicht."
  665.         GOTO neufilm
  666.      END IF
  667.      IF einnummer=0 THEN endveraendern
  668.      y=1
  669. kassuchen:
  670.      IF einnummer=kasnr%(y) THEN
  671.         x=y
  672.         kasnr%(y)=einnummer
  673.         va=1
  674.         CLS
  675.         GOSUB anfangeintr
  676.         GOTO endveraendern
  677.      END IF
  678.      y=y+1
  679.      GOTO kassuchen 
  680. einaendern:
  681.   CLS
  682.   LOCATE 8,2
  683.     PRINT "Bei welcher Film-Nr. sollen"
  684.   LOCATE 10,2
  685.     PRINT "Veränderungen vorgenommen"
  686.   LOCATE 12,2
  687.     PRINT "werden.";
  688.   COLOR 1
  689.     PRINT  "[ 0 ] ist gleich Ende."
  690.   LOCATE 15,2
  691.     PRINT "Filmnummer :";
  692. einfinuae:
  693.   LOCATE 15,14
  694.     INPUT a
  695.   IF a=0 THEN 
  696.     MENU ON
  697.     GOSUB farbe
  698.     RETURN
  699.   END IF  
  700.   IF a>vdfilme THEN
  701.     LOCATE 15,14
  702.       PRINT "    "
  703.     GOTO einfinuae
  704.   END IF
  705.   COLOR 2  
  706.   x=0
  707. veraensuch:
  708.   CLS
  709.   x=x+1
  710.   IF x=a THEN
  711.     SWAP tausch1$,ftitel$(x) 
  712.     SWAP tausch2$,mwnamen1$(x)
  713.     SWAP tausch3$,mwnamen2$(x)
  714.     SWAP tausch4$,musik$(x)
  715.     SWAP tausch5$,regie$(x)
  716.     LOCATE 6,2
  717.       PRINT "Wenn nichts Eingegeben wird,"
  718.     LOCATE 8,2
  719.       PRINT "wird der alte Name übernommen."
  720.     GOSUB taste
  721.     CLS
  722.     LOCATE 1,1
  723.       PRINT "Alter Titel"
  724.       PRINT  tausch1$
  725.       INPUT  austausch1$    
  726.     LOCATE 4,1
  727.       PRINT "Mitwirkende 1 Namen Alt"
  728.       PRINT tausch2$
  729.       INPUT austausch2$
  730.     LOCATE 7,1
  731.       PRINT "Mitwirkende 2 Name Alt"
  732.       PRINT tausch3$
  733.       INPUT austausch3$
  734.     LOCATE 10,1
  735.       PRINT "Musiker-Name Alt"
  736.       PRINT tausch4$
  737.       INPUT austausch4$
  738.     LOCATE 13,1
  739.       PRINT "Regie-Namen Alt"
  740.       PRINT tausch5$
  741.       INPUT austausch5$
  742.     LOCATE 17,1
  743.       PRINT "Die Kassetten-Nr. wird unver="
  744.       PRINT "ändert übernommen."
  745.     GOSUB taste
  746.     GOTO schlussveraen
  747.     END IF
  748.   GOTO veraensuch
  749. schlussveraen:  
  750.   IF austausch1$="" THEN
  751.     SWAP ftitel$(x),tausch1$
  752.   ELSE
  753.     SWAP ftitel$(x),austausch1$
  754.   END IF  
  755.   IF austausch2$="" THEN
  756.     SWAP mwnamen1$(x),tausch2$
  757.   ELSE
  758.     SWAP mwnamen1$(x),austausch2$
  759.     speichern=1
  760.   END IF
  761.   IF austausch3$="" THEN
  762.     SWAP mwnamen2$(x),tausch3$
  763.   ELSE
  764.     SWAP mwnamen2$(x),austausch3$
  765.     speichern=1
  766.   END IF
  767.   IF austausch4$="" THEN
  768.     SWAP musik$(x),tausch4$
  769.   ELSE
  770.     SWAP musik$(x),austausch4$
  771.     speichern=1
  772.   END IF
  773.   IF austausch5$="" THEN
  774.     SWAP regie$(x),tausch5$
  775.   ELSE
  776.     SWAP regie$(x),austausch5$
  777.     speichern=1
  778.   END IF
  779. endveraendern:  
  780.   MENU ON
  781.   GOSUB farbe
  782.   RETURN 
  783. warte:
  784.    FOR w=0 TO warten*1000
  785.    NEXT
  786.    warten=0
  787.    RETURN  
  788. autor:
  789.   WINDOW 3,"",(15,10)-(280,80 ),1,1
  790.   PRINT " Dies ist ein Public-Domain"
  791.   PRINT " Programm."
  792.   PRINT " Geschrieben und ausgedacht"
  793.   PRINT " von KLAUS-D.WIEGEL "
  794.   PRINT " Schröderstr.23 "
  795.   PRINT " 4670 LÜNEN "
  796.   PRINT "    linke Maustaste"
  797.   WHILE MOUSE(0)=0
  798.   SLEEP
  799.   WEND
  800.   WHILE MOUSE(0)<>0
  801.   WEND
  802.   WINDOW CLOSE 3
  803.   MENU ON
  804.   GOSUB farbe
  805.   RETURN 
  806. handhabung:
  807.   MENU OFF
  808.   CLS
  809.   LOCATE 1,6
  810.   PALETTE 0,1,.8,0
  811.   COLOR 1,2
  812.   PRINT "H A N D H A B U N G "
  813.   COLOR 2,0
  814.   LOCATE 3,3
  815.     PRINT "Handhabung im DOC-File "
  816.   LOCATE 5,3
  817.     PRINT "nachsehen."  
  818.   LOCATE 7,3  
  819.     PRINT "Viel Spass mit dem Programm"    
  820.   LOCATE 9,3
  821.     PRINT "wünscht der AUTOR."  
  822.   GOSUB taste  
  823.   MENU ON
  824.   GOSUB farbe
  825.   RETURN
  826. taste:
  827.   LOCATE 19,7
  828.   PRINT "Bitte Taste drücken"
  829. wartetaste: 
  830.   a$=INKEY$
  831.   IF a$<>"" THEN RETURN
  832.   SLEEP  
  833.   GOTO wartetaste
  834.      
  835. farbe:
  836.   COLOR 1,0
  837.   PALETTE 0,1,1,1 'weiß
  838.   PALETTE 1,1,0,0 'rot
  839.   PALETTE 2,0,0,0 'schwarz
  840.   PALETTE 3,1,1,0 'gelb
  841.   CLS
  842. text:
  843.   COLOR 1,0
  844.   LOCATE 2,6 
  845.   PRINT "Video-Film Verwaltung"
  846.   PUT (19,19),gr%
  847.   COLOR 3,1
  848.   LOCATE 8,10
  849.     PRINT "Video-Filme"
  850.   LOCATE 10,13
  851.     PRINT vdfilme  
  852.   COLOR 1,0
  853.   LOCATE 19,5
  854.   PRINT "Auswählen mit Menütaste"
  855.   RETURN
  856. grafik:   
  857.    COLOR 1,0
  858.    LINE (40,25)-(260,45),2,bf
  859.   FOR q=40 TO 256 STEP 6
  860.     LINE (q,26)-(q+2,28),0,bf
  861.   NEXT
  862.   FOR q=40 TO 256 STEP 6
  863.     LINE (q,42)-(q+2,44),0,bf
  864.   NEXT  
  865.   FOR q= 40 TO 240 STEP 20
  866.     LINE (q,26)-(q,44),0
  867.   NEXT
  868. 'kassette
  869.   LINE (40,110)-(100,140),2,bf
  870.   LINE (41,115)-(99,115),0
  871.   LINE (44,120)-(68,138),0,bf
  872.   LINE (72,120)-(96,138),0,bf
  873.   CIRCLE (56,129),10,2
  874.   CIRCLE (84,129),10,2
  875.   PAINT (56,129),2
  876.   PAINT (84,129),2
  877. 'kassette
  878.   LINE (200,110)-(260,140),2,bf
  879.   LINE (201,115)-(258,115),0
  880.   LINE (204,120)-(228,138),0,bf
  881.   LINE (232,120)-(256,138),0,bf
  882.   CIRCLE (216,129),10,2
  883.   CIRCLE (244,129),10,2
  884.   PAINT (216,129),2
  885.   PAINT (244,129),2
  886. 'kasten
  887.   LINE (85,65)-(220,97),2,bf
  888.   LINE (82,62)-(217,94),1,bf
  889.   GET (19,19)-(261,141),gr%
  890.  RETURN
  891.  
  892. gesamtliste:
  893.   CLS
  894.   MENU OFF
  895.   IF vdfilme=0 THEN
  896.     fehl$="GELISTET"
  897.     GOSUB fehlanzeige
  898.     MENU ON
  899.     GOSUB farbe
  900.     RETURN 
  901.   END IF       
  902.   numfika$="gelistet"
  903.   numfika1$="Film-Nr."
  904.   GOSUB nummerfika
  905.   CLS
  906.   PALETTE 0,.47,.8,.13
  907.   PALETTE 1,0,0,.6
  908.   PALETTE 2,.2,1,.93
  909.   PALETTE 3,.2,.73,1
  910.   COLOR 1,0
  911.   LOCATE 1,11
  912.    PRINT "L I S T E"
  913.   LOCATE 2,1
  914.    PRINT "Nr.         Titel       Kas.Nr."
  915.   LINE (0,20)-(320,21),2,bf
  916.   LINE (0,22)-(320,23),3,bf
  917.   LINE (0,24)-(320,25),2,bf
  918.   LINE (47,25)-(48,180),3,bf
  919.   LINE (265,25)-(266,180),3,bf
  920.   zeile=4
  921.   linie1=38
  922.   FOR x=f TO vdfilme
  923.    laenge=LEN(ftitel$(x))
  924.    IF laenge>21 THEN
  925.     gestitel$=LEFT$(ftitel$(x),21)
  926.     GOTO schreibges
  927.    END IF
  928.    gestitel$=ftitel$(x)
  929. schreibges:     
  930.    LOCATE zeile,1
  931.     PRINT x
  932.    LOCATE zeile,6
  933.     PRINT gestitel$
  934.    LOCATE zeile,28
  935.     PRINT kasnr(x)
  936.    LINE (0,linie1)-(320,linie1),2
  937.    LINE (47,25)-(48,200),3,bf
  938.    zeile=zeile+2
  939.    linie1=linie1+18
  940.    IF zeile=18 THEN
  941.      zeile=4
  942.      linie1=38
  943.      COLOR 3,1
  944.      LOCATE 18,7
  945.        PRINT "Verlassen mit[E]nde"
  946.      COLOR 1,0  
  947.      GOSUB taste
  948.      IF a$=CHR$(101) THEN
  949.        x=vdfilme
  950.        verlassen=1
  951.        GOTO endges
  952.      END IF  
  953.      FOR loesch=4 TO 16 STEP 2
  954.       LOCATE loesch,1
  955.        PRINT "    "
  956.       LOCATE loesch,6
  957.        PRINT "                     "
  958.       LOCATE loesch,28
  959.        PRINT "   "
  960.      NEXT 
  961.    END IF  
  962. endges: 
  963.   NEXT
  964.   IF verlassen=0 THEN
  965.     GOSUB taste
  966.   END IF
  967.   verlassen=0
  968.   MENU ON
  969.   GOSUB farbe
  970.   RETURN
  971. filmloeschen:
  972.        ftitel$(loeschfilm)=""      
  973.        mwnamen1$(loeschfilm)=""
  974.        mwnamen2$(loeschfilm)=""
  975.        musik$(loeschfilm)=""
  976.        regie$(loeschfilm)=""
  977.        kasnr%(loeschfilm)=0
  978.        speichern=1
  979.        RETURN
  980. aufkassette:
  981.  CLS
  982.  MENU OFF
  983.  IF vdfilme=0 THEN
  984.    fehl$="GELISTET"
  985.    GOSUB fehlanzeige
  986.    MENU ON
  987.    GOSUB farbe
  988.    RETURN 
  989.  END IF       
  990.  numfika$="gelistet"
  991.  numfika1$="Kass.-Nr"
  992.  GOSUB nummerfika
  993.  CLS
  994.  suc=1
  995. kasu:
  996.   IF kasnr%(suc)<f THEN
  997.      suc=suc+1
  998.      GOTO kasu
  999.   END IF
  1000.   LOCATE 1,6
  1001.   COLOR 3,2
  1002.    PRINT "Auflisten-Kassetten"
  1003.  zeile=5
  1004.  aufkas=suc
  1005. weiterkas:
  1006.    COLOR 3,2
  1007.    LOCATE 1,6
  1008.      PRINT "Auflisten-Kassetten"
  1009.    LOCATE 3,8
  1010.      PRINT "Kassette-Nr.";kasnr%(aufkas) 
  1011.    LOCATE 16,7
  1012.      PRINT "Verlassen mit [ESC]"   
  1013.    COLOR 1,0  
  1014.    test$=ftitel$(aufkas)
  1015.    GOSUB stringtest
  1016.    LOCATE zeile,stelle
  1017.      PRINT test$
  1018.    IF kasnr%(aufkas)< kasnr%(aufkas+1) THEN
  1019.      GOSUB taste
  1020.      IF a$=CHR$(27) THEN
  1021.        aufkas=vdfilme
  1022.        verlassen=1
  1023.      GOTO endekass  
  1024.      END IF  
  1025.      zeile=3
  1026.      FOR lo=5 TO 14
  1027.       LOCATE lo,1
  1028.        PRINT "                               "
  1029.      NEXT  
  1030.    END IF    
  1031.  zeile=zeile+2
  1032.  aufkas=aufkas+1
  1033.  IF aufkas<=vdfilme THEN weiterkas
  1034. endekass: 
  1035.  IF verlassen=0 THEN
  1036.    GOSUB taste
  1037.  END IF
  1038.  verlassen=0
  1039.  MENU ON
  1040.  GOSUB farbe
  1041.  RETURN
  1042. fehlanzeige:
  1043.       COLOR 1
  1044.       LOCATE 5,4
  1045.         PRINT "WAS BITTE SCHÖN SOLL HIER"
  1046.       LOCATE 6,4
  1047.         PRINT fehl$;" WERDEN ??       "
  1048.       LOCATE 7,4
  1049.         PRINT "ES SIND NOCH KEINE DATEN "     
  1050.       LOCATE 8,4
  1051.         PRINT "EINGELESEN ODER -GETRAGEN"
  1052.       LOCATE 9,4
  1053.         PRINT "WORDEN.                  "
  1054.       GOSUB taste
  1055.       RETURN
  1056. drucken:      
  1057.  MENU OFF
  1058.  CLS
  1059.  IF vdfilme=0 THEN
  1060.    fehl$="GEDRUCKT"
  1061.    GOSUB fehlanzeige
  1062.    GOSUB farbe
  1063.    MENU ON
  1064.    RETURN
  1065.  END IF
  1066.  numfika$="gedruckt"
  1067.  numfika1$="Kass.-Nr."
  1068.  GOSUB nummerfika
  1069.  CLS
  1070.  su=1
  1071. drsu:
  1072.   IF kasnr%(su)<f THEN
  1073.      su=su+1
  1074.      GOTO drsu
  1075.   END IF
  1076.  WIDTH"lpt1:",80
  1077.  OPEN"lpt1:"FOR OUTPUT AS #4
  1078.  COLOR 3,2
  1079.  aufkas=su
  1080. naechstebl:
  1081. FOR drk=1 TO 6 
  1082.   LOCATE 1,6
  1083.   PRINT "Drucken-Kassetten"
  1084.    druck$(1)="             Kassette-Nr."+STR$(kasnr%(aufkas))+SPACE$(12)
  1085.    FOR c=2 TO 9 STEP 2
  1086.      test$=ftitel$(aufkas)
  1087.      GOSUB drucktest
  1088.      dt=LEN(STR$(aufkas))
  1089.      IF dt>1 THEN
  1090.        leerd=4-dt
  1091.      END IF 
  1092.      druck$(c)=STR$(aufkas)+SPACE$(leerd)+CHR$(124)+test$+CHR$(124)
  1093.      druck$(c+1)="-------------------------------------"
  1094.      IF kasnr%(aufkas)< kasnr%(aufkas+1) THEN
  1095.        leerstring=1
  1096.        GOTO cnext
  1097.      END IF
  1098.      aufkas=aufkas+1  
  1099. cnext:
  1100.      IF leerstring=1 THEN
  1101.        cd=c+2
  1102.        FOR d=cd TO 9 STEP 2
  1103.          druck$(d)=SPACE$(4)+CHR$(124)+SPACE$(32)+CHR$(124)
  1104.          druck$(d+1)="-------------------------------------"
  1105.        NEXT
  1106.        leerstring=0
  1107.       c=9
  1108.       END IF
  1109.    NEXT
  1110.    aufkas=aufkas+1
  1111.    IF aufkas>vdfilme THEN ausdru   
  1112.    druck1$(1)="             Kassette-Nr."+STR$(kasnr%(aufkas))+SPACE$(12) 
  1113.    FOR c=2 TO 9 STEP 2
  1114.      test$=ftitel$(aufkas)
  1115.      GOSUB drucktest
  1116.      dt=LEN(STR$(aufkas))
  1117.      IF dt>1 THEN
  1118.        leerd=4-dt
  1119.      END IF  
  1120.      druck1$(c)=STR$(aufkas)+SPACE$(leerd)+CHR$(124)+test$+CHR$(124)
  1121.      druck1$(c+1)="-------------------------------------"
  1122.      IF kasnr%(aufkas)< kasnr%(aufkas+1) THEN
  1123.        leerstring=1
  1124.        GOTO c2next
  1125.        aufkas=aufkas-1
  1126.      END IF    
  1127.     aufkas=aufkas+1
  1128. c2next:
  1129.      IF leerstring=1 THEN
  1130.        cd=c+2
  1131.        FOR d=cd TO 9 STEP 2
  1132.          druck1$(d)=SPACE$(4)+CHR$(124)+SPACE$(32)+CHR$(124)
  1133.          druck1$(d+1)="-------------------------------------"
  1134.        NEXT
  1135.        leerstring=0
  1136.        c=9
  1137.       END IF
  1138.   NEXT
  1139. ausdru:   
  1140.    FOR dx=1 TO 9
  1141.     kadr$=druck$(dx)+druck1$(dx)
  1142.     PRINT #4,kadr$
  1143.    NEXT
  1144.  aufkas=aufkas+1
  1145.  IF aufkas>vdfilme THEN endedr
  1146. NEXT
  1147.  FOR led=1 TO 12
  1148.    PRINT #4,
  1149.  NEXT
  1150.  GOTO naechstebl
  1151. endedr:    
  1152.  MENU ON
  1153.  CLOSE #4
  1154.  GOSUB farbe
  1155.  RETURN
  1156. drucktest:
  1157.     te=LEN(test$)
  1158.     IF te>32 THEN test$=LEFT$(test$,32)
  1159.     IF LEN(test$)=32 THEN
  1160.       RETURN
  1161.     END IF
  1162.     leer=INT(LEN(test$)/2)
  1163.     IF leer<16 THEN
  1164.       tile=16-leer
  1165.       test$=SPACE$(tile)+test$+SPACE$(tile)
  1166.     END IF
  1167.     IF LEN(test$)<32 THEN
  1168.       test$=test$+SPACE$(1)
  1169.     ELSEIF LEN(test$)>32 THEN
  1170.       test$=LEFT$(test$,32) 
  1171.     END IF' 
  1172.  RETURN
  1173. nummerfika: 
  1174.   COLOR 1,0  
  1175.   LOCATE 4,2
  1176.     PRINT "Bitte die Nummer eingeben"
  1177.   LOCATE 6,2
  1178.     PRINT "ab der ";numfika$;" werden soll."
  1179.    COLOR 3,2
  1180.    LOCATE 8,17 
  1181.      PRINT "[Anfang=1]" 
  1182.    COLOR 1,0   
  1183. frageaufl:
  1184.   LOCATE 12,2
  1185.     PRINT  numfika1$;":";
  1186.   INPUT "",f
  1187.   x=f
  1188.   IF x=0 OR x>vdfilme THEN frageaufl
  1189.   z=1:y=3
  1190.   CLS
  1191.   RETURN
  1192.      
  1193.